home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1987 / 05 / joneslst.lst < prev    next >
File List  |  1987-04-10  |  9KB  |  292 lines
  1. Listing One
  2.  
  3. --                  DUNITS.ADA
  4. --                  VERSION 1
  5.  
  6. --                  1 JANUARY 1986
  7. --                  DO-WHILE JONES
  8. --                  324 TRACI LANE
  9. --                  RIDGECREST, CA 93555
  10. --                  (619) 375-4607
  11.  
  12. package DIMENSIONAL_UNITS is
  13.  
  14.   -- This package provides useful parent types for derived
  15.   -- dimensional units. That is, it makes it possible to
  16.   -- do this:
  17.  
  18.   --  type Feet is new Integer_Unit;
  19.   --  type Radians is new Float_Unit;
  20.  
  21.   --  PI           : constant Radians := Type_Convert(3.14159);
  22.   --  TARGET_RANGE : Feet;
  23.   --  ANGLE        : Radians;
  24.   --  REVOLUTIONS  : integer;
  25.  
  26.   -- These derived data types will inherit all the operations
  27.   -- in the package below. These are all the operations which
  28.   -- make sense for dimensional quantities.
  29.  
  30.   -- The modulo operation for Float_Units is provided to make
  31.   -- it easy to normalize angular measurements.
  32.  
  33.   --  ANGLE := ANGLE mod (2.0 * PI);
  34.  
  35.   -- The division operator for Float_Units which return INTEGERS
  36.   -- truncates toward zero (rather than rounding) to make it consistant
  37.   -- with integer division, and it lets you do this:
  38.  
  39.   --  REVOLUTIONS := ANGLE / (2.0 * PI);
  40.  
  41.   type Integer_Unit is private;
  42.  
  43.   function Type_Convert(X : integer) return Integer_Unit;
  44.     -- Lets you assign values to dimensional objects.
  45.     -- For example,
  46.  
  47.     -- TARGET_RANGE := Type_Convert(587);
  48.  
  49.   function "+"(RIGHT : Integer_Unit)
  50.     return Integer_Unit;
  51.   function "-"(RIGHT : Integer_Unit)
  52.     return Integer_Unit;
  53.   function "abs"(RIGHT : Integer_Unit)
  54.     return Integer_Unit;
  55.   function "+"(LEFT, RIGHT : Integer_Unit)
  56.     return Integer_Unit;
  57.   function "-"(LEFT, RIGHT : Integer_Unit)
  58.     return Integer_Unit;
  59.   function "*"(LEFT : integer; RIGHT : Integer_Unit)
  60.     return Integer_Unit;
  61.   function "*"(LEFT : Integer_Unit; RIGHT : integer) 
  62.     return Integer_Unit;
  63.   function "/"(LEFT : Integer_Unit; RIGHT : integer) 
  64.     return Integer_Unit;
  65.   function "/"(LEFT, RIGHT : Integer_Unit)
  66.     return integer;
  67.   function "/"(LEFT, RIGHT : Integer_Unit)
  68.     return float;
  69.   function "rem"(LEFT, RIGHT : Integer_Unit)
  70.     return Integer_Unit;
  71.   function "mod"(LEFT, RIGHT : Integer_Unit)
  72.     return Integer_Unit;
  73.   function Dimensionless(LEFT : Integer_Unit)
  74.     return integer;
  75.   function Dimensionless(LEFT : Integer_Unit)
  76.     return float;
  77.  
  78.   -- "=" and "/=" are already defined for private types
  79.   function "<"(LEFT, RIGHT : Integer_Unit)
  80.     return boolean;
  81.   function "<="(LEFT, RIGHT : Integer_Unit)
  82.     return boolean;
  83.   function ">"(LEFT, RIGHT : Integer_Unit)
  84.     return boolean;
  85.   function ">="(LEFT, RIGHT : Integer_Unit)
  86.     return boolean;
  87.  
  88.   type Float_Unit is private;
  89.  
  90.   function Type_Convert(X : float) return Float_Unit;
  91.     -- Lets you assign values to dimensional objects.
  92.     -- For example,
  93.  
  94.     -- ANGLE := Type_Convert(3.14159);
  95.  
  96.   function "+"(RIGHT : Float_Unit)
  97.     return Float_Unit;
  98.   function "-"(RIGHT : Float_Unit)
  99.     return Float_Unit;
  100.   function "abs"(RIGHT : Float_Unit)
  101.     return Float_Unit;
  102.   function "+"(LEFT, RIGHT : Float_Unit)
  103.     return Float_Unit;
  104.   function "-"(LEFT, RIGHT : Float_Unit)
  105.     return Float_Unit;
  106.   function "*"(LEFT : integer; RIGHT : Float_Unit)
  107.     return Float_Unit;
  108.   function "*"(LEFT : Float_Unit; RIGHT : integer) 
  109.     return Float_Unit;
  110.   function "*"(LEFT : float; RIGHT : Float_Unit)
  111.     return Float_Unit;
  112.   function "*"(LEFT : Float_Unit; RIGHT : float) 
  113.     return Float_Unit;
  114.   function "/"(LEFT : Float_Unit; RIGHT : integer) 
  115.     return Float_Unit;
  116.   function "/"(LEFT : Float_Unit; RIGHT : float) 
  117.     return Float_Unit;
  118.   function "/"(LEFT, RIGHT : Float_Unit)
  119.     return integer; -- trucates toward zero
  120.   function "/"(LEFT, RIGHT : Float_Unit)
  121.     return float;
  122.   function "rem"(LEFT, RIGHT : Float_Unit)
  123.     return Float_Unit;
  124.   function "mod"(LEFT, RIGHT : Float_Unit)
  125.     return Float_Unit;
  126.   function Dimensionless(LEFT : Float_Unit)
  127.     return integer;
  128.   function Dimensionless(LEFT : Float_Unit)
  129.     return float;
  130.  
  131.   -- "=" and "/=" are already defined for private types
  132.   function "<"(LEFT, RIGHT : Float_Unit)
  133.     return boolean;
  134.   function "<="(LEFT, RIGHT : Float_Unit)
  135.     return boolean;
  136.   function ">"(LEFT, RIGHT : Float_Unit)
  137.     return boolean;
  138.   function ">="(LEFT, RIGHT : Float_Unit)
  139.     return boolean;
  140.  
  141. -- The following don't have any application to dimensional
  142. -- problems. I almost hid them in the package body, but I
  143. -- thought that since I needed them to derive some of the
  144. -- Float_Unit operations someone else might need them, too.
  145.  
  146.   function "/"(LEFT, RIGHT : float) return integer;
  147.     -- divide and truncate toward zero
  148.  
  149.   function "rem"(LEFT, RIGHT : float) return float;
  150.  
  151.   function "mod"(LEFT, RIGHT : float) return float;
  152.  
  153. private
  154.  
  155.   type Integer_Unit is new integer;
  156.   type Float_Unit is new float;
  157.  
  158. end DIMENSIONAL_UNITS;
  159.  
  160.  
  161.  
  162.  
  163.  
  164. Listing Two
  165.  
  166. --                    DUEX.ADA
  167. -- This is an example of how the use of dimensional units as data
  168. -- types improves program clarity.
  169.  
  170. ------------------------- Compilation Unit 1 --------------------------
  171.  
  172. with DIMENSIONAL_UNITS; use DIMENSIONAL_UNITS;
  173. package SPEED_GUN_UNITS is
  174.  
  175.   type Miles_per_hour is new Integer_Unit;
  176.   type Hertz is new Float_Unit;
  177.   type Miles_per_second is new Float_Unit;
  178.  
  179.   function Type_Convert(X : Miles_per_second)
  180.    return Miles_per_hour;
  181.  
  182.   function "*"(LEFT : Miles_per_second; RIGHT : float)
  183.    return Miles_per_hour;
  184.  
  185. end SPEED_GUN_UNITS;
  186.  
  187. ------------------------- Compilation Unit 2 --------------------------
  188.  
  189. with SPEED_GUN_UNITS; use SPEED_GUN_UNITS;
  190. package HARDWARE_CIRCUITS is
  191.   function Xmit_Frequency_Measurement return Hertz;
  192.   function Doppler_Frequency_Measurement return Hertz;
  193.   procedure put(X : Miles_per_hour);
  194. end HARDWARE_CIRCUITS;
  195.  
  196. ------------------------- Compilation Unit 3 --------------------------
  197.  
  198. with HARDWARE_CIRCUITS; use HARDWARE_CIRCUITS;
  199. with SPEED_GUN_UNITS; use SPEED_GUN_UNITS;
  200. procedure Speed_Gun is
  201.   TRANSMIT_FREQUENCY, DOPPLER_FREQUENCY : Hertz;
  202.   SPEED : Miles_per_hour;
  203.   C : constant Miles_per_second
  204.    := Type_Convert(186_280.0); -- speed of light
  205. begin
  206.   TRANSMIT_FREQUENCY := Xmit_Frequency_Measurement;
  207.   DOPPLER_FREQUENCY := Doppler_Frequency_Measurement;
  208.   SPEED := (C / 2.0) * (DOPPLER_FREQUENCY / TRANSMIT_FREQUENCY);
  209.   put(SPEED);
  210. end Speed_Gun;
  211.  
  212.  
  213.  
  214.  
  215. ------------------------- Compilation Unit 4 --------------------------
  216.  
  217. package body SPEED_GUN_UNITS is
  218.  
  219.   function Type_Convert(X : Miles_per_second)
  220.    return Miles_per_hour is
  221.     MPH : Miles_per_second;
  222.   begin
  223.     MPH := X * 60 * 60;
  224.     return Type_Convert(Dimensionless(MPH));
  225.   end Type_Convert;
  226.  
  227.   function "*"(LEFT : Miles_per_second; RIGHT : float)
  228.    return Miles_per_hour is
  229.   begin
  230.     return Type_Convert(LEFT * RIGHT);
  231.   end "*";
  232.  
  233. end SPEED_GUN_UNITS;
  234.  
  235. ------------------------- Compilation Unit 5 --------------------------
  236.  
  237. with TEXT_IO; use TEXT_IO;
  238. package body HARDWARE_CIRCUITS is
  239.   -- The statements below are standing in for code which would
  240.   -- read the frequency directly from hardware circuits and
  241.   -- would display speed on an LCD or LED display. Since I'm
  242.   -- using a terminal as a substitute input device I used
  243.   -- TEXT_IO to get and put data.
  244.  
  245.   package INT_IO is new INTEGER_IO(integer); use INT_IO;
  246.   package F_IO is new FLOAT_IO(float); use F_IO;
  247.  
  248.   function Xmit_Frequency_Measurement return Hertz is
  249.     F : float;
  250.   begin
  251.     put("What is the Transmit Frequency (in Hertz)? ");
  252.     get(F);
  253.     skip_line; -- TEXT_IO quirk
  254.     return Type_Convert(F);
  255.   end Xmit_Frequency_Measurement;
  256.  
  257.   function Doppler_Frequency_Measurement return Hertz is
  258.     F : float;
  259.   begin
  260.     put("What is the Doppler Frequency (in Hertz)? ");
  261.     get(F);
  262.     skip_line; -- TEXT_IO quirk
  263.     return Type_Convert(F);
  264.   end Doppler_Frequency_Measurement;
  265.  
  266.   procedure put(X : Miles_per_hour) is
  267.     I : integer;
  268.   begin
  269.     I := Dimensionless(X);
  270.     put("The speed is "); put(I); put_line(" MPH.");
  271.   end put;
  272.  
  273. end HARDWARE_CIRCUITS;
  274.  
  275. ------------------------- Test Results --------------------------
  276.  
  277. $ run speed_gun
  278. What is the Transmit Frequency (in Hertz)? 10.0e9
  279. What is the Doppler Frequency (in Hertz)? 1600.0
  280. The speed is          54 MPH.
  281. $ 
  282. $ run speed_gun
  283. What is the Transmit Frequency (in Hertz)? 10.0e9
  284. What is the Doppler Frequency (in Hertz)? 1000.0
  285. The speed is          34 MPH.
  286. $ 
  287. $ run speed_gun
  288. What is the Transmit Frequency (in Hertz)? 10.0e9
  289. What is the Doppler Frequency (in Hertz)? 2000.0
  290. The speed is          67 MPH.
  291. $ 
  292.